Shareware Grab Bag/Shareware Grab Bag.iso/090/ledt.arc/LE-D&T.PAS

Pascal/Delphi Source File | 1986-02-27 | 4.9 KB | 183 lines

{  LE-D&T.PAS   Leading Edge Date & Time Program.  For model M (same as
   Sperry PC), I don't know about the "D" model.
                       Craig Roberts,  [phone]

    When I upgraded to a hard disk, I went to PC-DOS 3.1 to gain the
    SUBST command.  However, I lost the LE-modified MS-DOS which reads
    the LE clock.  So, I wrote this program so I can boot from the hard
    disk and not have to enter the date & time.  LE-D&T reads the clock
    according to the hardware spec in the LE manual.  No, it doesn't
    allow you to update the clock.  Throw your old MS-DOS in the A drive,
    the enter the date & time like the MS manual says.

  Operation:
   The following program uses the MsDos command in Turbo to
   retrieve the system date.  This is achieved via DOS function
   call 42 (or 2A hex).  The function call is placed in the AH
   register according to the technical reference manual.  The
   tricky places are the delays, provided by the delay function.
   There are probably more elegent ways to program, but it works.

  Update History
   Modified by Craig   11/16/85 !!!!
   *}

program datetime;
type
  string10 = string[10];
  TimeStr = string10;
  DateStr = string10;

Var
  Sec, Hour,Min,AM_PM,Month,Day,Year: String[2];
  Sc,  Hr,  Mi, Wd,   Mo,   Da, Yr : integer ;
  Regs: Record Case Integer Of
                1: (AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags: Integer);
                2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
              End;
  tyme : timestr ;
  dayte : datestr ;
Const
  WeekDay : array [0..6] of string10 =
          ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday',
           'Saturday');


Procedure ZeroFill(Var S: String10);
  Var
    I: Integer;
  Begin
    For I:=1 To Length(S) Do If S[I]=' ' Then S[I]:='0';
  End;

function Time: TimeStr;
begin
    With Regs Do
     Begin
      AH:=$2C;
      Flags:=0;
      MsDos(Regs);
      AM_PM:='am';
      If CH>11 Then
       Begin
        CH:=CH-12;
        AM_PM:='pm';
       End;
      If CH=0 Then CH:=12;
      Str(CH:2,Hour);
      Str(CL:2,Min);
      Tyme:=Hour+':'+Min+AM_PM;
      ZeroFill(Tyme);

     End; { With Regs }
  time := tyme ;
end; { time  }

procedure getLeDaTime ;  { from LE clock  }
const LEclcal   = $2A2 ;
      dataRead  = $40 ;
      busyRead  = $10 ;
      addrWrite = $80 ;
      S1Addr    = $00 ;
      S10Addr   = $01 ;
      Mi1Addr   = $02 ;
      Mi10Addr  = $03 ;
      H1Addr    = $04 ;
      H10Addr   = $05 ;
      WAddr     = $06 ;
      D1Addr    = $07 ;
      D10Addr   = $08 ;
      Mo1Addr   = $09 ;
      Mo10Addr  = $0A ;
      Y1Addr    = $0B ;
      Y10Addr   = $0C ;
var   DataByte : byte ;

function ReadOperation (Addr : byte ) : byte ;
begin
{ addr write  }
  port[LEclCal] := addrWrite or addr ;
  delay (1);
  port[LEclCal] := addr ;

  repeat
    if keypressed then halt ;
    port[LEclCal] := dataRead ;
    delay(2);  { >1.5 msec  }
    dataByte := port[LEclCal] ;
  until (DataByte and busyRead  ) <> 0 ;
  ReadOperation := dataByte and $0F ;
  port[LEclCal] := $00 ;

end ; { waitnotBusy  }

begin { getTime  }
  Sc := ReadOperation(S10Addr)*10 + ReadOperation(S1Addr) ;
  Mi := ReadOperation(Mi10Addr) * 10 + ReadOperation(Mi1Addr) ;
  Hr :=  (ReadOperation(H10Addr) and $03) * 10 + ReadOperation(H1Addr) ;
  Wd :=  readOperation(WAddr) ;
  Da := readOperation(D10Addr) * 10 + readOperation(D1Addr) ;
  Mo :=  readOperation(Mo10Addr) * 10 + readoperation(Mo1Addr) ;
  Yr :=  readOperation(y10Addr) * 10 + 1980 + ReadOperation(Y1Addr) ;
end ; { getLeDaTime  }

procedure setDosDaTime ;
begin
{  writeln('Date :',mo:3,da:3,yr:3,Wd:5);}
  with Regs do
   begin
     CX := Yr ;
     DL := Da ;
     DH := Mo ;
     AL := Wd ;
     AH:=$2B;
     Flags:=0;
     MsDos(Regs);
   end;
{  writeln('Time :',hr:3,mi:3,sc:3);}
  with Regs do
   begin
     CH := Hr ;
     CL := Mi ;
     DH := Sc ;
     DL := 00 ;
     AH := $2D ;
     Flags:=0;
     MsDos(Regs);
   end;
end;

function Date: DateStr;

begin
  with Regs do
   begin
      AH:=$2A;
      Flags:=0;
      MsDos(Regs);
      Str((CX Mod 100):2,Year);
      Str(DL:2,Day);
      Str(DH:2,Month);
      Dayte:=Month+'/'+Day+'/'+Year;
      ZeroFill(Dayte);
   end;
  date := dayte ;
end;  { date  }

function setWhite : string10 ; begin TextColor(White); setWhite := ''; end;
function setRedBack : string10 ;
     begin TextBackground(red); setRedBack := ''; end;
function setBlackBack : string10 ;
     begin TextBackground(Black); setBlackBack := ''; end;

begin
  getLeDaTime ;
  setDosDaTime ;
  writeln;
  writeln;
  writeln(setWhite,'╒',setRedBack,' DateTime 1.01 ',
                      setBlackBack,'══════════════════════════╕');
  writeln(setWhite,'│                                         │');
  writeln(setWhite,'│ It is now ',weekday[Wd]:9,',  ',date,'  ', time, ' │');
  writeln(setWhite,'└─────────────────────────────────────────┘');
end.